home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
exitpas.zip
/
EXIT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-05-14
|
3KB
|
106 lines
unit ExitStuf;
(****************************************************************************
I am: David Neal Dubois
Zelkop Software
P.O. Box 5177
Armdale, Nova Scotia
Canada, B3L 4M7
CompuServe ID: 71401,747
I can usually be found on the BProgA forum,
or you can EasyPlex me.
Ware-ness: Donated to the public domain. If you use it
please mention my name.
Unit ExitStuf provides a single procedure, RegisterExitProcedure,
designed to make it easier to set up exit routines in Turbo Pascal.
It takes a single parameter, the name of the procedure you want
called. The procedures used have the same limitations as those
imposed by Turbo Pascal for normal exit procedures. It must be a
global procedure, take no parameters, and must be called FAR. The
exit procedure need not deal with the global ExitProc variable.
The procedure works by setting up a linked list of procedures.
When its own exit routine is activated, it calls each of the
procedures it has been asked to register in reversed sequence.
Besides saving the bother of dealing with the ExitProc variable,
RegisterExitProcedure has the added benefit of forcing the compiler
to check that the procedure is suitable. If the procedure does not
fill the proper criteria, the program will not compile. This is not
the case if you deal with the ExitProc variable.
The only thing I can think that you would have to careful of, is
that this procedure uses a very small amount of heap space, 8 bytes
per call.
Here a simple example of a program using this unit. It merely
registers an exit procedure and then terminates:
program TestExitStuf;
uses ExitStuf;
{$F+} procedure Exit;
begin
writeln ( 'Main is terminating.' );
end;
begin
writeln ( 'The exit procedure is being registered.' );
RegisterExitProcedure ( Exit );
writeln ( 'The program will now exit.' );
end.
***************************************************************************)
interface
type
ExitProcType = procedure;
procedure RegisterExitProcedure ( NewExitProc : ExitProcType );
implementation
type
NodePtr = ^ NodeType;
NodeType = record
TheExitProc : ExitProcType;
Next : NodePtr;
end;
var
ExitList : NodePtr;
OldExitProc : pointer;
procedure RegisterExitProcedure ( NewExitProc : ExitProcType );
{ Adds the parameter to the linked list. }
var
Node : NodePtr;
begin
new ( Node );
Node ^ . TheExitProc := NewExitProc;
Node ^ . Next := ExitList;
ExitList := Node;
end;
{$F+}
procedure Exit;
{ Processes each procedure in the linked list. }
begin
while ExitList <> nil do
begin
ExitList ^ . TheExitProc;
ExitList := ExitList ^ . Next;
end;
end;
begin
ExitList := nil;
OldExitProc := ExitProc;
ExitProc := @ Exit;
end.